home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Dr. Windows 3
/
dr win3.zip
/
dr win3
/
PROGRAMR
/
ANIMAT.ZIP
/
ANIMATOR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-10-11
|
3KB
|
138 lines
(* By Scott D. Stephenson, CIS #70564,677 *)
(* 10 Oct 93 *)
(* Program shell courtesy of Boilerplate (copyright L. David Baldwin) *)
(* Mr Baldwin has written several Pascal tools found on the BPascal SIG (thanks!) *)
(* Animator is a rather crude "toy" program I wrote in a moment of boredom. *)
(* Basically, I wanted to see if I could animate the desktop background screen. *)
(* This version simply draws sun-like rays on the desktop window at one second intervals. *)
(* There sure is a lot of room for improvement in this code. *)
(* If you create better animations, and I sure hope you will, *)
(* please post them so we can all enjoy the fun! *)
(* The Animator source code is free to all. *)
program animator;
{$R animator.RES}
uses
Objects, OWindows, ODialogs, WinTypes, WinProcs, Strings, OStdDlgs, OStdWnds, Windos;
type
TMyApp = object(TApplication)
procedure InitInstance; virtual;
procedure InitMainWindow; virtual;
end;
PMyWindow = ^TMyWindow;
TMyWindow = object(TDlgWindow)
P_101 : PStatic;
procedure WMTimer (var Msg: TMessage); virtual wm_First + Wm_Timer;
constructor Init(ATitle : PChar);
procedure SetupWindow ; virtual;
function GetClassName : PChar; virtual;
procedure GetWindowClass(var AWndClass : TWndClass); virtual;
destructor Done; virtual;
end;
const
Textlen = 25; {!!change as appropriate}
var DesktopRectangle: trect;
procedure desktoptest;
var desk: hwnd;
dc: hdc;
x: integer;
r: trect;
begin
randomize;
copyrect(r,desktoprectangle);
with r do
begin
left:= random(left);
top:= random(top);
right:= random(right);
bottom:= random(bottom);
end;
desk:= getdesktopwindow;
dc:= getdc(desk);
selectobject(desk,getstockobject(black_brush));
moveto(dc,r.left,r.top);
lineto(dc,r.right,r.bottom);
releasedc(desk,dc);
end;
procedure TMyWindow.WMTimer (var Msg: TMessage);
begin
desktoptest;
end;
{-------TMyWindow.Init}
constructor TMyWindow.Init(ATitle : PChar);
begin
TDlgWindow.Init(Nil, 'ANIMATOR');
New(P_101, InitResource(@Self, 101, Textlen));
end;
{-------TMyWindow.SetupWindow;}
procedure TMyWindow.SetupWindow;
begin
TDlgWindow.SetupWindow;
P_101^.SetText('A String');
setTimer(hwindow,1,1000,nil);
getclientrect(getdesktopwindow,DesktopRectangle);
end;
{-------TMyWindow.GetClassName}
function TMyWindow.GetClassName : PChar;
begin
GetClassName := 'ANIMATOR';
end;
{-------TMyWindow.GetWindowClass}
procedure TMyWindow.GetWindowClass(var AWndClass : TWndClass);
begin
TDlgWindow.GetWindowClass(AWndClass);
with AWndClass do
begin
hCursor := LoadCursor(0, PChar(idc_Arrow));
hIcon := LoadIcon(0, PChar(idi_Application));
Style := cs_Vredraw or cs_Hredraw;
end;
end;
{------TMyWindow.Done}
destructor TMyWindow.Done;
var r: trect;
begin
TDlgWindow.Done;
KillTimer(hWindow,1 );
(* hey, we don't want to leave our desktop cluttered after we quit! *)
InvalidateRect(getdesktopwindow,@DesktopRectangle,true);
end;
{------TMyApp.InitMainWindow}
procedure TMyApp.InitMainWindow;
begin
MainWindow := New(PMyWindow, Init(''));
end;
{------TMyApp.InitInstance}
procedure TMyApp.InitInstance;
begin
TApplication.InitInstance;
hAccTable := 0;
end;
var
App : TMyApp;
begin
App.Init('MyWindow');
App.Run;
App.Done;
end.